COMMENT ⊗   VALID 00012 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Definitions.  The file DEFS must be assembled with this file.
C00005 00003	Storage allocations.
C00009 00004	FILER
C00012 00005	CHKTEM
C00014 00006	NEWFIL	GETTTY
C00017 00007	END1
C00020 00008	GETCH	PUTCH	PUTSTR
C00022 00009	UUCODE	NXTDG
C00023 00010	CHGNAM	INTRPT
C00025 00011	CONVRT
C00030 00012	SETSHF  CLRSHF  SPE1-7  CKPARA
C00048 ENDMK
C⊗;
;Definitions.  The file DEFS must be assembled with this file.

	TITLE	FILER of AP news

;BUFCNT←←1	;TYPE OUT NUMBER OF CHARS IN EACH BUFFER FROM TTY12

;IFNDEF DEBUG <DEBUG←←0>
IFNDEF BUFCNT <BUFCNT←←0>

TTY12←←1  TTY←←0  DISK←←0  ;EXACTLY ONE OF THESE SHOULD BE NON-ZERO
IFN TTY12*TTY  <TOO MANY INPUT DEVICES!!!!>
IFN TTY12*DISK <TOO MANY INPUT DEVICES!!!!>
IFN TTY  *DISK <TOO MANY INPUT DEVICES!!!!>
IFN TTY12+TTY <BUFLN←←30>
IFN DISK  <BUFLN←←200>

;     ACCUMULATOR ASSIGNMENTS
F←0	;unused
A←1		;TEMPORARY AC
B←2		;TEMPORARY AC
C←3		;CURRENT CHAR
D←4	;unused
E←5		;LF COUNTER--USED TO DETECT END OF STORY

L←6		;LAST CHAR SEEN
M←7		;NUMBER OF COLS OUTPUT SO FAR ON CURRENT LINE
N←10		;NUMBER OF FREE BYTES LEFT IN OUTPUT BUFFER

Q←11	;unused
R←12	;unused

W←13		;W,X,Y,Z ARE USED AS LOOKUP/ENTER BLOCK
X←14
Y←15
Z←16

P←17		;pdl pointer

I←←0		;CHANNEL FOR TTY12 INPUT
T←←1		;CHANNEL FOR OUTPUT TEXT FILE
T1←←2		;CHANNEL FOR LOOKING UP OLD OUTPUT FILE TO SEE IF IT IS GONE
;Storage allocations.

OBUF:	BLOCK	3		;output buffer header
NOBUFS←←3
DSKBUF:	BLOCK	NOBUFS*203	;OUTPUT BUFFER AREA FOR TEXT FILE PASSED TO DOER

IBUF:	BLOCK	3		;input buffer header
NIBUFS←←4
TTYBUF:	BLOCK	NIBUFS*(BUFLN+3)  ;the input buffers for tty12 go here

LPDL←←10
PDL:	BLOCK	LPDL	;area for stack

DSK17:	217		;block used for opening the dsk in mode 17 many times
	SIXBIT	/DSK/	;200 bit means take error return automatically
	0		;if DISK IS FULL or BAD RETRIEVAL

DONAME:	SIXBIT /[DOER]/

DOER:	SIXBIT	/DSK/	;block used to start up DOER
	SIXBIT	/DOER/	;program name goes here
	'DMP',,14	;USE NEW JOB and dont set JLOG
	0		;normal starting address, normal core assignment
PPN:	APPPN
	APPPN

ERRBK:	SIXBIT	/DSK/	;block used to start up error-handling program
	ERRPRG		;program name goes here
	'DMP',,0
	1		;NORMAL CORE SIZE, RPG STARTUP (SA+1)
	APPPN
	APPPN

SHIFT:	0		;flag indicating upper or lower shift characters
CRLF:	ASCIZ	/
/

APNAME:	SIXBIT /[-NS-]/
;FILER

FILER:	RESET
	MOVE	P,[IOWD LPDL,PDL];initialize pdl pointer
	MOVEI	A,INTRPT	;get address of interrupt level module
	MOVEM	A,JOBAPR↑	;store it
	MOVSI	A,INTPTI!INTPAR	;enable interrupts on parity errors
	INTENB	A,		;	and pty input
	MOVSI	A,INTPTI
	INTGEN	A,		;generate a pty input int to set the job name
	MOVE	A,NBRFLR#	;get code indicating number of other filers
	JRST	.+2(A)
	UEXIT	4	;	;ONE OTHER FILER ALREADY EXISTED
	UERROR	10	;	;TWO OR MORE OTHER FILERS ALREADY EXISTED

IFN TTY12    <INIT I,411	;grab AP news line, take error return if not avail
	      SIXBIT /TTY12/>
IFN TTY+DISK <INIT I,1     >
IFN TTY      <SIXBIT /TTY/  >
IFN DISK     <SIXBIT /DSK/  >
	IBUF
	UBIGERR	14	;	;INIT FAILED ON TTY12

	MOVSI	A,000700	;7-BIT BYTES
	MOVEM	A,IBUF+1

	MOVEI	B,TTYBUF	;set up buffers for TTY12 at TTYBUF
	EXCH	B,JOBFF↑
	INBUF	I,NIBUFS
	MOVEM	B,JOBFF		;restore old value of JOBFF

	SETZM	OLDNAM		;ZERO NAME OF PREVIOUS OUTPUT FILE
	SETZM	SHIFT
;CHKTEM

	INIT	T1,210		;LOOK AT UFD FOR A .TEM FILE TO RENAME TO .TFL
	SIXBIT	/DSK/
	OBUF			;ACTUALLY INPUT BUFFER HEADER
	UBIGERR	20	;	;

	MOVEI	B,DSKBUF
	EXCH	B,JOBFF↑
	INBUF	T1,NOBUFS
	MOVEM	B,JOBFF

	MOVE	W,PPN
	MOVSI	X,'UFD'
	MOVE	Z,['  1  1']
	LOOKUP	T1,W		;LOOKUP UFD
	UBIGERR
	MOVEI	A,2
	MOVNI	B,4
CHKTEM:	IN	T1,
	JRST	CHKTE1
	STATO	T1,20000
	UBIGERR
	PUSHJ	P,CLSUFD	;CLOSE UFD (T1)
	JRST	NEWFIL
CHKTE1:	ILDB	W,OBUF+1	;get filename from UFD
	ILDB	X,OBUF+1	;get extension
	ADDM	A,OBUF+1	;skip last two words of each UFD entry
	HLLZ	X,X
	CAMN	X,['TEM   ']	;is this a .TEM file?
	TDNE	W,[760000,,400000]	;ANY OF THESE BITS ON MEANS CANT BE OURS
	JRST	CHKTE2
	SETZ	Z,		;got one of our .TEM files
	OPEN	T,DSK17
	UBIGERR
	LOOKUP	T,W
	JRST	CHKTE2		;IF CANT OPEN IT, IGNORE IT
	PUSHJ	P,CLSUFD	;CLOSE UFD (T1)
	JRST	END1		;GO RENAME TO .TFL
CHKTE2:	ADDM	B,OBUF+2	;DECREMENT BUFFER HEADER BYTE COUNT
	SKIPLE	OBUF+2		;ANYTHING ELSE IN BUFFER?
	JRST	CHKTE1		;YES
	JRST	CHKTEM

CLSUFD:	RELEAS	T1,
	SETZM	DSKBUF		;CLEAR OUTPUT BUFFERS FOR HOT
	MOVE	A,[DSKBUF,,DSKBUF+1]
	BLT	A,DSKBUF+203*NOBUFS-1
	POPJ	P,
;NEWFIL	GETTTY

NEWFIL:	INIT	T,200		;CREATE A NEW OUTPUT FILE
	SIXBIT	/DSK/
	0
	UBIGERR	20	;	;

	ACCTIM	W,		;USE <DATE>,,<TIME> AS FILENAME
	HLRZ	X,W		;GET DATE
	DAYCNT	X,		;CONVERT TO DAYCNT FORMAT
	HRL	W,X
	MOVSI	X,'TEM'
	SETZB	Y,Z
	ENTER	T,W
	AOJA	W,[ENTER T,W	;TRY AT MOST TWICE TO DO AN ENTER
		UBIGERR 24	;	;CANT ENTER OUTPUT FILE
		JRST .+1]
	MOVEM	W,TEMNAM#	;SAVE NAME OF CURRENT FILE

	INIT	T,200		;RELEASE NEW FILE AND OPEN IN RA MODE
	SIXBIT	/DSK/
	OBUF,,0
	UBIGERR	20	;	;

	MOVEI	B,DSKBUF
	EXCH	B,JOBFF↑
	OUTBUF	T,NOBUFS
	MOVEM	B,JOBFF

	SETZ	Z,
	LOOKUP	T,W		;LOOKUP NEW (EMPTY) FILE
	UBIGERR	30	;	;GONE ALREADY?
	SETZ	Z,
	ENTER	T,W		;OPEN FOR OUTPUT IN RA MODE
	UBIGERR	34	;	;WHAT??

GETTTY:	MOVEI	E,2
GETTT1:	PUSHJ	P,GETCH		;GET AP CHAR AND OUTPUT IT
	CAIE	C,LF		;LOOK FOR 3 STRAIGHT LFs
	MOVEI	E,3		;HAVEN'T SEEN ANY YET
	SOJGE	E,GETTT1
;END1

	MOVEI	C,200		;MAKE SURE STORY ENDS WITH NULL
	PUSHJ	P,PUTCH
	OUT	T,		;PUT OUT LAST PARTIAL BUFFER
	AOSA	OBUF+2		;KEEP BYTE COUNT ACCURATE
	UBIGERR	36	;	;
	MTAPE	T,[SIXBIT/GODMOD/↔17]	;AND UPDATE RETRIEVAL

	OPEN	T1,DSK17
	UBIGERR	40	;	;
	MOVE	W,OLDNAM#
	MOVSI	X,'TFL'
	SETZB	Z,C
	LOOKUP	T1,W		;LOOK FOR PREVIOUS OUTPUT FILE
	SETO	C,		;APPARENTLY NOT THERE
	RELEAS	T1,
	JUMPE	C,END2		;PREVIOUS FILE STILL THERE.  DONT START NEW FILE

	CLOSE	T,		;PREVIOUS FILE GONE.  CLOSE CURRENT FILE.
	MOVE	W,TEMNAM#	;GET NAME OF CURRENT OUTPUT FILE
END1:	MOVSI	X,'TFL'
	SETZB	Y,Z
	RENAME	T,W		;RENAME .TFL←.TEM
	UBIGERR	44	;	;
	RELEAS	T,
	MOVEM	W,OLDNAM	;SAVE NAME OF THIS FILE

END2:	MOVEI	B,DOER		;think about starting up DOER
	MOVE	A,DONAME	;see if a DOER job exists
	NAMEIN	A,
	ORI	A,400		;NOTE THAT NAMEIN FAILED (NO UNIQUE DOER)
	CAIN	A,401		;CHECK ERROR CODE
	SWAP	B,		;NO DOERS.  START ONE UP
	JUMPE	C,GETTTY	;NO NEW FILE YET
	JRST	NEWFIL		;GO OPEN A NEW OUTPUT FILE
;GETCH	PUTCH	PUTSTR

GETCH:	SOSLE	IBUF+2		;ANY CHARS IN INPUT BUFFER
	JRST	GETCH1		;YES.  GET ONE.
	IN	I,		;NO.  GET NEW BUFFER
	JRST	GETCH2
IFN TTY+DISK <
	STATZ	I,20000		;END OF FILE?
	EXIT			;YES
>;END IFN TTY+DISK
	UBIGERR	50	;	;

GETCH2:
IFN TTY12+TTY <
	MOVE	A,IBUF+2	;GET NUMBER OF CHARS IN BUFFER
IFN TTY12 <
IFN BUFCNT <
	PUSHJ	P,NXTDG
	OUTCHR	[" "]
	MOVE	A,IBUF+2
>;END IFN BUFCNT
>;END IFN TTY12
	CAIGE	A,5*BUFLN
	JRST	GETCH1		;NOT FULL BUFFER
	MOVEI	A,[ASCIZ/...
/]				;FULL BUFFER--ASSUME WE MISSED SOME CHARS
	PUSHJ	P,PUTSTR	;INSERT "...CRLF"
>;END IFN TTY12+TTY

GETCH1:	ILDB	C,IBUF+1
IFN TTY12 <
	TRNE	C,100
	JRST	[MOVEI C,"%"	;100 BIT ON IN AP-LINE CHAR
		JRST PUTCH]	;PUT OUT FUNNY CHAR
	ADD	C,SHIFT		;ACCOUNT FOR CURRENT SHIFT SETTING
	XCT	CONVRT(C)	;CONVERT FROM AP CODE TO ASCII
>;END IFN TTY12
	JUMPE	C,GETCH		;FALL INTO PUTCH IF NOT NULL CHAR

PUTCH:	SOSG	OBUF+2		;ANY ROOM LEFT IN OUTPUT BUFFER?
	OUT	T,		;NO.  WRITE OUT BUFFER
	JRST	PUTCH1
	UBIGERR	54	;	;
PUTCH1:	IDPB	C,OBUF+1
	POPJ	P,

PUTSTR:	TLOA	A,440700	;MAKE A BYTE POINTER
PUTST1:	PUSHJ	P,PUTCH
	ILDB	C,A
	JUMPN	C,PUTST1
	POPJ	P,
;UUCODE	NXTDG

UUCODE:	0
halt .+1
	SETO	A,
	GETLIN	A
	AOJE	A,DET
	OUTSTR	[ASCIZ /
FILER error #/]
	HRRZ	A,40		;get error number
	PUSHJ	P,NXTDG		;TYPE OUT ERROR NUMBER
	EXIT	1,
	HALT	.
	JRST	@UUCODE

DET:	RESET
	MOVE	1,APNAME	;PASS JOB NAME IN AC 1
	MOVE	2,40		; AND ERROR UUO IN AC 2
	MOVEI	16,ERRBK
	SWAP	16,
	EXIT

NXTDG:	IDIVI	A,=8		;convert number in A to octal ASCII string
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,NXTDG
	HLRZ	A,(P)
	ADDI	A,"0"
	OUTCHR	A
	POPJ	P,
;CHGNAM	INTRPT

;interrupt level routine to set the job name
CHGNAM:	SETZ	A,			;zero out own job name
	SETNAM	A,
	SETOM	NBRFLR#			;initialize indicator to one other filer
	MOVE	A,APNAME		;get filer's name from wakeme block
	NAMEIN	A,
	JRST	.+2			;zero or multiple filers exist
	DISMIS				;one other filer exists
	SETZM	NBRFLR			;set indicator to multiple filers
	CAIE	A,1			;check error code of NAMEIN
	DISMIS				;two or more other filers exist
	AOS	NBRFLR			;set indicator to no other filers
	MOVE	A,APNAME		;change job name
	SETNAM	A,
	MOVEI	A,200000
	INTACM	A,			;disable for further pdl ov ints
	DISMIS

;interrupt level module
INTRPT:	MOVSI	C,INTPAR	;enable interrupts only on parity errors
	INTENB	C,
	MOVS	A,JOBCNI↑	;get bit causing interrupt
	CAIN	A,INTPTI	;is this interrupt to set filer's job name?
	JRST	CHGNAM		;yes.  do it
	CAIE	A,INTPAR
	DISMIS			;IGNORE STRANGE INTERRUPT
	UWAIT			;PARITY ERROR.  GIVE UP AND GO HOME
	JRST	2,@[.+1]	;get out of user-iot
	DEBREAK
	UEXIT	60	;	;PARITY ERROR IN FILER
;CONVRT

CONVRT:	JRST	GETCH		;0: tape feed
	MOVEI	C,"e"	;1
	MOVEI	C,LF		;2: elevate→line feed
	MOVEI	C,"a"	;3
	JRST	CKPARA		;4: space.  make into 4 spaces if after LF
	MOVEI	C,"s"	;5
	MOVEI	C,"i"	;6
	MOVEI	C,"u"	;7
	MOVEI	C,CR		;10: carriage return
	MOVEI	C,"d"	;11
	MOVEI	C,"r"	;12
	MOVEI	C,"j"	;13
	MOVEI	C,"n"	;14
	MOVEI	C,"f"	;15
	MOVEI	C,"c"	;16
	MOVEI	C,"k"	;17
	MOVEI	C,"t"	;20
	MOVEI	C,"z"	;21
	MOVEI	C,"l"	;22
	MOVEI	C,"w"	;23
	MOVEI	C,"h"	;24
	MOVEI	C,"y"	;25
	MOVEI	C,"p"	;26
	MOVEI	C,"q"	;27
	MOVEI	C,"o"	;30
	MOVEI	C,"b"	;31
	MOVEI	C,"g"	;32
	JRST	SETSHF		;33: shift
	MOVEI	C,"m"	;34
	MOVEI	C,"x"	;35
	MOVEI	C,"v"	;36
	JRST	CLRSHF		;37: unshift

	JRST	CKPARA		;40: thin space→space
	MOVEI	C,"3"	;41
	MOVEI	C,LF		;42: paper feed→line feed
	MOVEI	C,"$"	;43
	JRST	CKPARA		;44: add thin space→space
	JRST	CKPARA		;45: em space→space
	MOVEI	C,"8"	;46
	MOVEI	C,"7"	;47
	MOVEI	C,"'"	;50
	MOVEI	C,"-"	;51
	MOVEI	C,"4"	;52
	JRST	GETCH		;53: bell
	MOVEI	C,","	;54: comma
	JRST	GETCH		;55: undefined
	JRST	CKPARA		;56: en space→space
	JRST	GETCH		;57: quad right
	MOVEI	C,"5"	;60
	MOVEI	C,")"	;61
	JRST	CKPARA		;62: em space→space
	MOVEI	C,"2"	;63
	JRST	GETCH		;64: em leader
	MOVEI	C,"6"	;65
	MOVEI	C,"0"	;66
	JRST	GETCH		;67: en leader
	MOVEI	C,"9"	;70
	JRST	GETCH		;71: upper rail
	MOVEI	C,";"	;72
	JRST	GETCH		;73: lower rail
	MOVEI	C,"."	;74: period
	MOVEI	C,"1"	;75
	JRST	GETCH		;76: undefined
	JRST	GETCH		;77: rub out


UPPER:	JRST	GETCH		;0: tape feed
	MOVEI	C,"E"	;1
	MOVEI	C,LF		;2: elevate→line feed
	MOVEI	C,"A"	;3
	JRST	CKPARA		;4: space.  make into 4 spaces if after LF
	MOVEI	C,"S"	;5
	MOVEI	C,"I"	;6
	MOVEI	C,"U"	;7
	MOVEI	C,CR		;10: carriage return
	MOVEI	C,"D"	;11
	MOVEI	C,"R"	;12
	MOVEI	C,"J"	;13
	MOVEI	C,"N"	;14
	MOVEI	C,"F"	;15
	MOVEI	C,"C"	;16
	MOVEI	C,"K"	;17
	MOVEI	C,"T"	;20
	MOVEI	C,"Z"	;21
	MOVEI	C,"L"	;22
	MOVEI	C,"W"	;23
	MOVEI	C,"H"	;24
	MOVEI	C,"Y"	;25
	MOVEI	C,"P"	;26
	MOVEI	C,"Q"	;27
	MOVEI	C,"O"	;30
	MOVEI	C,"B"	;31
	MOVEI	C,"G"	;32
	JRST	SETSHF		;33: shift
	MOVEI	C,"M"	;34
	MOVEI	C,"X"	;35
	MOVEI	C,"V"	;36
	JRST	CLRSHF		;37: unshift

	JRST	CKPARA		;40: thin space→space
	JRST	SPE3		;41: 3/8
	MOVEI	C,LF		;42: paper feed→line feed
	MOVEI	C,"!"	;43
	JRST	CKPARA		;44: add thin space→space
	JRST	CKPARA		;45: em space→space
	MOVEI	C,"-"	;46
	JRST	SPE7		;47: 7/8
	MOVEI	C,"'"	;50: left quote→right quote (ttys dont have left quote)
	MOVEI	C,"+"	;51
	JRST	SPE4		;52: 1/2
	JRST	GETCH		;53: bell
	MOVEI	C,","	;54: comma
	JRST	GETCH		;55: undefined
	JRST	CKPARA		;56: en space→space
	JRST	GETCH		;57: quad right
	JRST	SPE5		;60: 5/8
	MOVEI	C,"("	;61
	JRST	CKPARA		;62: em space→space
	JRST	SPE2		;63: 1/4
	JRST	GETCH		;64: em leader
	JRST	SPE6		;65: 3/4
	MOVEI	C,"?"	;66
	JRST	GETCH		;67: en leader
	MOVEI	C,"&"	;70
	JRST	GETCH		;71: upper rail
	MOVEI	C,":"	;72
	JRST	GETCH		;73: lower rail
	MOVEI	C,"."	;74: period
	JRST	SPE1		;75: 1/8
	JRST	GETCH		;76: undefined
	JRST	GETCH		;77: rub out
;SETSHF  CLRSHF  SPE1-7  CKPARA

CLRSHF:	TDZA	C,C
SETSHF:	MOVEI	C,100
	MOVEM	C,SHIFT
	JRST	GETCH
SPE1:	MOVEI	A,[ASCIZ ⊗ 1/8⊗]
	JRST	PUTSTR
SPE2:	MOVEI	A,[ASCIZ ⊗ 1/4⊗]
	JRST	PUTSTR
SPE3:	MOVEI	A,[ASCIZ ⊗ 3/8⊗]
	JRST	PUTSTR
SPE4:	MOVEI	A,[ASCIZ ⊗ 1/2⊗]
	JRST	PUTSTR
SPE5:	MOVEI	A,[ASCIZ ⊗ 5/8⊗]
	JRST	PUTSTR
SPE6:	MOVEI	A,[ASCIZ ⊗ 3/4⊗]
	JRST	PUTSTR
SPE7:	MOVEI	A,[ASCIZ ⊗ 7/8⊗]
	JRST	PUTSTR

CKPARA:	MOVEI	C," "
	CAILE	E,1		;if the previous char was a LF, CNT will be 1
	JRST	PUTCH		;not after LF--put out a space
	MOVEI	A,[ASCIZ ⊗    ⊗]	;AFTER LF--PUT OUT FOUR SPACES
	JRST	PUTSTR

	END	FILER